home *** CD-ROM | disk | FTP | other *** search
/ L' Effet Pommier 3 / L'Effet Pommier - Volume 03.iso / Graphismes / Bitmap / NIH Image 1.59 / Macros / Color < prev    next >
Text File  |  1995-02-28  |  3KB  |  180 lines

  1. macro 'Color Merge Two Images';
  2. {
  3. Merges a "red" image and a "green" image to
  4. create a composite color image by creating a
  5. temporary 24-bit image and converted to 8-bits.
  6. Assumes dark objects on a light background.
  7. Remove the two Invert commands if this is not
  8. the case. Requires a lot of memory.
  9. }
  10. var
  11.   i,w1,w2,h1,h2,rgb:integer;
  12. begin
  13.   RequiresVersion(1.50);
  14.   SaveState;
  15.   if nPics<>2 then begin
  16.      PutMessage('This macro operates on exactly two images.');
  17.      exit;
  18.   end;
  19.   SelectPic(1);
  20.   GetPicSize(w1,h1);
  21.   SelectPic(2);
  22.   GetPicSize(w2,h2);
  23.   if (w1<>w2) or (h1<>h2) then begin
  24.      PutMessage('The two images must have the same width and height.');
  25.     exit;
  26.   end;
  27.   SetNewSize(w1,h2);
  28.   SetBackground(255);
  29.   MakeNewStack('RGB');
  30.   AddSlice;
  31.   AddSlice;
  32.   rgb:=PicNumber;
  33.   SelectPic(1);
  34.   SelectAll;
  35.   Copy;
  36.   SelectPic(rgb);
  37.   SelectSlice(1);
  38.   Paste;
  39.   Invert;
  40.   SelectPic(2);
  41.   SelectAll;
  42.   Copy;
  43.   SelectPic(rgb);
  44.   SelectSlice(2);
  45.   Paste;
  46.   Invert;
  47.   RGBToIndexed('Custom, Dither');
  48.   SelectPic(rgb);
  49.   Dispose;
  50.   SelectPic(3);
  51.   RestoreState;
  52. end;
  53.  
  54.  
  55. macro 'Color Merge Two Stacks';
  56. {
  57. Merges a "red" stack and a "green" stack to
  58. create a new composite color stack.
  59. }
  60. var
  61.   i,w1,w2,h1,h2,d1,d2,d3:integer;
  62.   rgb,merged:integer;
  63. begin
  64.   RequiresVersion(1.50);
  65.   SaveState;
  66.   if nPics<>2 then begin
  67.     PutMessage('This macro operates on exactly two stacks.');
  68.     exit;
  69.   end;
  70.   SelectPic(1);
  71.   GetPicSize(w1,h1);
  72.   d1:=nSlices;
  73.   SelectPic(2);
  74.   GetPicSize(w2,h2);
  75.   d2:=nSlices;
  76.   if (d1=0) or (d2=0) then begin
  77.     PutMessage('Both images must be stacks.');
  78.     exit;
  79.   end;
  80.   if d1>=d2
  81.     then d3:=d2
  82.     else d3:=d1;
  83.   if (w1<>w2) or (h1<>h2) then begin
  84.     PutMessage('The two stacks must have the same width and height.');
  85.     exit;
  86.   end;
  87.   SetNewSize(w1,h2);
  88.   SetBackground(255);
  89.   MakeNewStack('RGB');
  90.   AddSlice;
  91.   AddSlice;
  92.   rgb:=PicNumber;
  93.   SetPalette('System');
  94.   MakeNewStack('Merged');
  95.   merged:=PicNumber;
  96.   for i:=1 to d3 do begin
  97.     SelectPic(1);
  98.     SelectSlice(i);
  99.     SelectAll;
  100.     Copy;
  101.     {DeleteSlice;}
  102.     SelectPic(rgb);
  103.     SelectSlice(1);
  104.     SelectAll;
  105.     Paste;
  106.     Invert;
  107.     SelectPic(2);
  108.     SelectSlice(i);
  109.     SelectAll;
  110.     Copy;
  111.     {DeleteSlice;}
  112.     SelectPic(rgb);
  113.     SelectSlice(2);
  114.     SelectAll;
  115.     Paste;
  116.     Invert;
  117.     SelectPic(rgb);
  118.     RGBToIndexed('System');
  119.     SelectAll;
  120.     Copy;
  121.     Dispose;
  122.     SelectPic(merged);
  123.     Paste;
  124.     if i<>d3 then AddSlice;
  125.    end;
  126.   SelectPic(rgb);
  127.   Dispose;
  128. {
  129.   SelectPic(1);
  130.   Dispose;
  131.   SelectPic(1);
  132.   Dispose;
  133. }
  134.   RestoreState;
  135. end;
  136.  
  137. procedure CheckForRGBStack;
  138. begin
  139.    if (nPics=0) or (nSlices<>3) then begin
  140.     PutMessage('This macro requires an RGB stack.');
  141.     exit
  142.   end;
  143. end;
  144.  
  145. macro 'Enhance Contrast';
  146. var
  147.   i:integer;
  148. begin
  149.   CheckForRGBStack;
  150.   for i:=1 to 3 do begin
  151.      SelectSlice(i);
  152.      EnhanceContrast;
  153.      ApplyLUT;
  154.   end;
  155.   RGBToIndexed('Custom LUT, Dither');
  156. end;
  157.  
  158. macro 'RGB to 8-Bit Color';
  159. begin
  160.   RGBToIndexed('Custom LUT, Dither');
  161. end;
  162.  
  163. macro '8-Bit Color to RGB';
  164. begin
  165.   IndexedToRGB;
  166. end;
  167.  
  168.  
  169. macro '8-Bit Color to Grayscale';
  170. begin
  171.   ApplyLUT;
  172. end;
  173.  
  174.  
  175. macro 'Sort LUT by Hue';
  176. begin
  177.   SortPalette;
  178. end;
  179.  
  180.